Business Shareware

home *** CD-ROM | disk | FTP | other *** search

/ Business Shareware / Business Shareware.iso / start / database / lib194 / finance.prg < prev next >

Wrap

Text File | 1993-02-05 | 45.2 KB | 1,096 lines

*------------------------------------------------------------------------------- *-- Program...: FINANCE.PRG *-- Programmer: Ken Mayer (CIS: 71333,1030) *-- Date......: 02/05/1993 *-- Notes.....: These finance functions are for use with interest rates and *-- such. See the file README.TXT for details about the use of this *-- library file. *-- *-- NOTES ABOUT THESE ROUTINES (the ones written by Jay Parsons) *-- The functions that use (1+nRate)^nPeriods require that the *-- rate be stated in the same terms as the compounding period. *-- That is, for monthly compounding the nRate should be the annual *-- rate / 12, and the nPeriods the number of months, and so forth. *-- *-- If the situation involves continuous compounding, state the *-- rate as the exponent of the annual rate, less 1, and state the *-- periods in years. Accordingly, to find the value in 30 months *-- of a $1000 investment continuously compounded at 6%, use: *-- FuturVal(1000,exp(.06)-1,30/12) *-- *-- These functions (except NPV(), which sums a series of equal *- or unequal cash flows), are designed for use with a single *-- "investment", one payment or receipt. If the problem involves *-- a series of equal payments or receipts like a mortgage loan, *-- a Holiday Club or an annuity, the fv() and pv() functions *-- built in to dBASE IV should be used instead where possible. *------------------------------------------------------------------------------- FUNCTION Discount *------------------------------------------------------------------------------- *-- Programmer..: Jay Parsons (CIS: 70160,340) *-- Date........: 03/01/1992 *-- Notes.......: Compute the present value of an amount to be received at the *-- end of a number of periods given a periodic interest rate. *-- Written for.: dBASE IV, 1.1 *-- Rev. History: None *-- Calls.......: None *-- Called by...: Any *-- Usage.......: Discount(<nFuturVal>,<nRate>,<nPeriods>) *-- Example.....: ?Discount(1000,.08,6) *-- Returns.....: Numeric *-- Parameters..: nFuturVal = the amount to be received/paid in the future *-- nRate = the periodic rate of interest *-- nPeriods = the number of periods *------------------------------------------------------------------------------- parameters nFuturVal, nRate, nPeriods RETURN nFuturVal / ( 1 + nRate ) ^ nPeriods *-- EoF: Discount() FUNCTION FuturVal *------------------------------------------------------------------------------- *-- Programmer..: Jay Parsons (CIS: 70160,340) *-- Date........: 03/01/1992 *-- Notes.......: Compute the future value of an initial amount at compound *-- interest received at a given periodic rate for a number of *-- periods. *-- Written for.: dBASE IV, 1.0 *-- Rev. History: None *-- Calls.......: None *-- Called by...: Any *-- Usage.......: FuturVal(<nPresVal>,<nRate>,<nPeriods>) *-- Example.....: ?FuturVal(10000,.06,48) *-- Returns.....: Numeric *-- Parameters..: nPresVal = Present Value *-- nRate = Periodic interest rate *-- nPeriods = Number of periods to calculate for *------------------------------------------------------------------------------- parameters nPresVal, nRate, nPeriods RETURN nPresVal * ( 1 + nRate ) ^ nPeriods *-- EoF: FuturVal() FUNCTION Rate *------------------------------------------------------------------------------- *-- Programmer..: Jay Parsons (CIS: 70160,340) *-- Date........: 03/01/1992 *-- Notes.......: Compute rate of periodic interest needed to produce a future *-- value from a present value in a given number of periods. If *-- the periods are not years, you'll probably want to multiply *-- the rate returned by the number of periods in a year to *-- obtain the equivalent annual rate. *-- Written for.: dBASE IV, 1.1 *-- Rev. History: None *-- Calls.......: None *-- Called by...: Any *-- Usage.......: Rate(<nFutVal>,<nPresVal>,<nPeriods>) *-- Example.....: ?Rate(50000,10000,48) *-- Returns.....: Numeric *-- Parameters..: nFutVal = Future Value *-- nPresVal = Present Value *-- nPeriods = Number of periods to calculate for *------------------------------------------------------------------------------- parameters nFutVal, nPresVal, nPeriods RETURN ( nFutVal / nPresVal ) ^ ( 1 / nPeriods ) - 1 *-- EoF: Rate() FUNCTION ContRate *------------------------------------------------------------------------------- *-- Programmer..: Jay Parsons (CIS: 70160,340) *-- Date........: 03/01/1992 *-- Notes.......: Rate if compounding is continuous. Periods must be years. *-- Written for.: dBASE IV, 1.1 *-- Rev. History: None *-- Calls.......: RATE() Function in FINANCE.PRG *-- Called by...: Any *-- Usage.......: ContRate(<nFutVal>,<nPresVal>,<nYears>) *-- Example.....: ?ContRate(50000,10000,4) *-- Returns.....: Numeric *-- Parameters..: nFutVal = Future Value *-- nPresVal = Present Value *-- nYears = Number of years to calculate for *------------------------------------------------------------------------------- parameters nFutVal, nPresVal, nYears RETURN log( 1 + Rate( nFutval, nPresval, nYears ) ) *-- EoF: ContRate() FUNCTION NPV *------------------------------------------------------------------------------- *-- Programmer..: Tony Lima (CIS: 72331,3724) and Jay Parsons (CIS: 70160,340) *-- Date........: 03/01/1992 *-- Notes.......: Net present value of array aCashflow[ nPeriods ] *-- Calculates npv given assumed rate and # periods. *-- See "Other inputs" below for instructions/details ... *-- Written for.: dBASE IV, 1.1 *-- Rev. History: None *-- Calls.......: None *-- Called by...: Any *-- Usage.......: NPV(<nRate>,<nPeriods>) *-- Example.....: ? NPV( .06, 6 ) *-- Returns.....: Float = value of the project at given rate *-- Parameters..: nRate = Interest Rate *-- : nPeriods = Number of Periods to calculate for *-- Other inputs: Requires the array aCashflow[ ] set up before calling. *-- : Each of its elements [n] holds the cash flow at the *-- : beginning of period n, with a negative amount indicating *-- : a cash outflow. Elements of value 0 must be included for *-- : all periods with no cash flow, and all periods must be of *-- : equal length. *-- : If the project is expected to require an immediate outlay *-- : of $6,000 and to return $2,000 at the end of each of the *-- : first five years thereafter, the array will be: *-- : aCashflow[1] = -6000 *-- : aCashflow[2] = 2000 *-- : aCashflow[3] = 2000 *-- : * * * *-- : aCashflow[6] = 2000 *-- : *-- : If the cash flows are at the end of the periods, rather *-- : than at the beginning, assign 0 to aCashFlow[1], then *-- : assign cash flows successively. aCashFlow[2] will then *-- : represent the cash flow at the end of period 1, rather *-- : than at the beginning of period 2, which is the same thing. *-- : *-- : Rewriting the function to have array name passed as a *-- : parameter is possible, but will slow down execution to an *-- : extent that will be very noticeable if this function is being *-- : repeatedly executed, as by Zeroin() to find an Internal Rate *-- : of Return. *------------------------------------------------------------------------------- parameters nRate, nPeriods private nDiscount, nFactor, nPeriod, nNpv nPeriod = 1 nNpv = aCashflow[ 1 ] nDiscount = float( 1 ) nFactor = 1 / ( 1 + nRate ) do while nPeriod < nPeriods nPeriod = nPeriod + 1 nDiscount = nDiscount * nFactor nNpv = nNpv + aCashflow[ nPeriod ] * nDiscount enddo RETURN nNpv *-- EoF: NPV() FUNCTION Irr *------------------------------------------------------------------------------- *-- Programmer..: Jay Parsons (CIS: 70160,340) *-- : Based on code by Tony Lima (CIS: 72331,3724), 1990. *-- Date........: 4/13/1992 *-- Notes.......: Finds internal rate of return using Zeroin(). *-- : An internal rate of return is an interest rate at *-- : which the net present value of a series of cash flows *-- : is zero. In the normal case of an investment, where *-- : cash flows out at first, then comes back in later periods, *-- : the IRR gives the interest rate for an equally-good deal, and *-- : investments with higher IRR should be considered first. *-- : *-- : As this function uses the Npv() function to evaluate the *-- : cash flows at each assumed rate, and Npv() requires for *-- : speed that the cash flows be placed in the array aCashflow[], *-- : the cash flows must be placed there before calling this *-- : function. The number of rows in aCashflow[] is a parameter *-- : passed through by Zeroin() to Npv(). *-- : *-- Written for.: dBASE IV Version 1.5 *-- Rev. History: Original function 1990. *-- : Modified to match Zeroin(), Npv(), 4/13/1992 *-- Calls : Zeroin() Function in STATS.PRG *-- : Arrayrows() Function in ARRAYS.PRG *-- Called by...: Any *-- Usage.......: ? Irr( <fX1>, <fX2>, n_Flag ) *-- Example.....: nRate = Irr( 11, 0, 200, n_Flag ) *-- Returns : a float value representing Irr, if n_Flag < 3. *-- Parameters..: fX1, lowest plausible rate of return from this project. *-- : fX2, highest plausible rate of return, ditto. *-- : n_Flag, an integer to signal success ( < 3 ) or failure. *-- Other input : Requires advance setup of array to be called by Npv, *-- : as furnished "aCashflow[]", to hold cash flows. *-- Side effects: Uses and alters a global numeric variable, here called *-- : "n_Flag", to report error conditions resulting in value *-- : returned being meaningless. *------------------------------------------------------------------------------- PARAMETERS fX1, fX2, n_Flag RETURN Zeroin( "Npv", fX1, fX2, float( 1 / 10 ^ 6 ), 100, ; n_Flag, arrayrows( "aCashflow" ) ) *-- EoF: Irr() FUNCTION Irr2 && {version 1.01} *------------------------------------------------------------------------------- *-- Programmer...: Ron Allen (CIS: 71201,2502) *-- Date.........: 01/25/1993 *-- Notes........: Returns internal rate of return on an investment from *-- evenly-spaced periodic cashflows. The UDF simultaneously *-- accumulates the periodic Net Present Values of the *-- individual cashflows along with the first derivative of *-- the function. After the summation is completed for each *-- guess, the guess is adjusted by subtracting the ratio *-- of the function to its derivative. *-- Written for..: dBASEIV, version 1.5, tested on build xx71 *-- Rev. History.: 1.01 01/28/93 - to add missing private variables. To *-- count iterations without sign change in PV. Move *-- division by nRatio outside inner loop. *-- Calls........: None *-- Called by....: Any *-- Usage........: Irr2(<nN>, <cFlow>, <lSw>, <nGuess>) *-- Example......: Rate = Irr2(6, "Cash", Switch, .01) *-- Returns......: Internal Rate of Return. *-- Parameters...: nN = number of cashflows in model *-- cFlow = name of the array holding the cashflows *-- lSw = name of a logical variable to be switched to *-- indicate valid IRR returned (.t.). *-- nGuess = optional guess for initialing search. *------------------------------------------------------------------------------- parameters nN, cFlow, lSw, nGuess private nI, nPosVal, nNegVal, nCurVal, nIRR, nNuDelta, nOlDelta, nBigchange private nSignChng, nDiscount, nRatio, nSumPV, nCurrPV, nSumDeriv, nOldPV private nIters, lSw1 store 0 to nI, nPosVal, nNegVal, nIters store .t. to lSw store .f. to lSw1 declare nCashFlow[nN] *-- Transfer cashflows to a private array and separate negatives from *-- positives do while nI < nN nI = nI+1 store &cFlow[nI] to nCashFlow[nI], nCurVal if nCurVal < 0 nNegVal = nNegVal + nCurVal else nPosVal = nPosVal + nCurVal endif enddo if nNegVal = 0 .or. nPosVal = 0 wait "Must have at least one positive and one negative value" endif *-- Use initializing guess if provided, otherwise calculate from *-- weighted average returns. if pcount() = 4 nIRR = nGuess else nIRR = ((-nPosVal/nNegVal)-1)/nN endif *-- Housekeeping summary accumulators, etc., before entering loop store 1 to nNuDelta, nOlDelta store 0 to nSignChng, nBigChange *-- Loop until estimated rate indicated accuracy do while abs(nNuDelta) > .000001 store 0 to nI, nSumPV, nSumDeriv *-- Set up cumulative denominator to calculate incremental NPV nDiscount = 1 nRatio = 1 + nIRR do while nI < nN nI = nI+1 nDiscount = nDiscount/nRatio *-- Calculate incremental PV and add to sum nCurrPV = nDiscount * nCashFlow[nI] nSumPV = nSumPV + nCurrPV *-- Add incremental first derivative to derivative sum nSumDeriv = nSumDeriv - nI * nCurrPV enddo *-- count iterations and test for sign change of future value if .not. lSw1 .and. nIters > 0 lSw1 = iif(sign(nOldPV) = sign(nSumPV),.f.,.t.) endif nIters = nIters + 1 nOldPV = nSumPV *-- Calculate indicated change in IRR nNuDelta = nRatio * nSumPV/nSumDeriv *-- Test for big changes in adjusted IRR, limit to 10 times *-- current guess for IRR and count big changes. if abs(nNuDelta/nIRR) > 10 nNuDelta = sign(nNuDelta) * 10 * nIRR nBigChange = nBigChange + 1 endif nIRR = nIRR - nNuDelta && Make adjustment to guess for IRR *-- Count reversals in adjustments to limit hunting nSignChng = nSignChng + iif(sign(nNuDelta) + sign(nOlDelta) = 0,1,0) nOlDelta = nNuDelta *-- Test for hunting, too many bigchanges or too large a solution *-- and set external switch if abnormal exit is used. if nSignChng + nBigChange > 10 .or. abs(nIRR) > 100 .or. ; (nIters > 9 .and. .not. lSw1) store .f. to lSw exit endif enddo RETURN nIRR *-- EoF: Irr2() FUNCTION Mirr && {version 1.0} *------------------------------------------------------------------------------- *-- Programmer...: Ron Allen (CIS: 71201,2502) *-- Date.........: 01/27/1993 *-- Notes........: Used to calculate the Modified Internal Rate of Return *-- for evenly-spaced periodic cashflows. The modifications *-- assume that more realistic investment models should *-- account for the cost of borrowing or the lower 'safe' *-- rate for keeping reserve funds to cover outlays and the *-- fact that reinvestments will be made at some other rate *-- than the IRR itself. This model calculates the answer *-- directly, therefore more rapidly than the iterative *-- approach used by IRR. *-- Written for..: dBASEIV, version 1.5, tested on build xx71 *-- Rev. History.: None *-- Calls........: None *-- Called by....: Any *-- Usage........: Mirr(<nN>, <cFlow>, <nRrate>, <nFrate>) *-- Example......: Rate = Mirr(6, "Cash", .1, .14) *-- Returns......: Modified Internal Rate of Return per period. *-- Parameters...: nN = number of cashflows in model *-- cFlow = name of the array holding the cashflows *-- nRrate = Reinvestment rate for positive cashflows. *-- nFrate = 'Safe' rate expected on reserve funds to *-- cover disbursements. *------------------------------------------------------------------------------- parameters nN, cFlow, nRrate, nFrate private nI, nNegVal, nPosVal, nCurVal store 0 to nI, nNegVal, nPosVal *-- Pass through array once computing present value of negative *-- cashflows at 'safe' rate and present value of positive values *-- at the reinvestment rate. do while nI < nN nI = nI+1 nCurVal = &cFlow[nI] nCurVal = nCurVal*(1+iif(nCurVal<0,nFrate,nRrate))^-(nI-1) if nCurVal < 0 nNegVal = nNegVal + nCurVal else nPosVal = nPosVal + nCurVal endif enddo if abs(nNegVal) = 0 .or. nPosVal = 0 wait " There must be at least one negative and one positive value! " return 0 endif *-- Calculate the rate of return required to yield a future value *-- of the positive values reinvested at nRrate from the present *-- value of the negative values invested at the 'safe' rate. RETURN ((-nPosVal * (1+nRrate)^(nN-1))/nNegVal)^(1/(nN-1))-1 *-- EoF: Mirr() FUNCTION Xmirr && {version 1.01} *------------------------------------------------------------------------------- *-- Programmer...: Ron Allen (CIS: 71201,2502) *-- Date.........: 01/27/1993 *-- Notes........: Used to calculate the Modified Internal Rate of Return *-- from cashflows on random dates. Except for the need to *-- supply both the dates of transactions and the cashflows *-- in an 'nN' by 2 array, the other inputs are the same as *-- in Mirr(). Dates may be in random order except for the *-- first date. The first date in the array establishes *-- the date to which present value applies. Enter 'Safe' *-- rate for reserves and 'Reinvestment' rate for positive *-- cashflows as annual rates, e.g., .075 for 7.5%. *-- Written for..: dBASEIV, version 1.5, tested on build xx71 *-- Rev. History.: 1.01 01/27/93 - to allow entry of 'Safe' reserve rate *-- and 'Reinvestment' rate as annual rates rather than *-- rates. Also, to return the 'effective' rate of interest *-- when compounded daily, rather than the 'nominal' rate. *-- Calls........: None *-- Called by....: Any *-- Usage........: Xmirr(<nN>, <cFlow>, <nRrate>, <nFrate>) *-- Example......: Rate = Xmirr(5, "Cash", .14, .1) *-- Returns......: Annualized Effective Modified Internal Rate of Return *-- based on daily compounded interest. *-- Parameters...: nN = number of cashflows in model *-- cFlow = name of 'nN' by 2 array holding the dates (col 1) *-- and cashflow amounts (col 2). *-- nRrate = Reinvestment rate for positive cashflows. *-- nFrate = 'Safe' rate expected on reserve funds to *-- cover disbursements. *------------------------------------------------------------------------------- parameters nN, cFlow, nRrate, nFrate private nI, nCurVal, nNegVal, nPosVal, dPDate private dMaxDate, dCurDate, nCurN, nMirr store 0 to nI, nNegVal, nPosVal store (1+nRrate)^(1/365)-1 to nRrate store (1+nFrate)^(1/365)-1 to nFrate store &cFlow[1,1] to dPDate dMaxDate = dPDate do while nI < nN nI = nI+1 nCurVal = &cFlow[nI,2] dCurDate = &cFlow[nI,1] dMaxDate = max(dCurDate,dMaxDate) nCurN = dCurDate-dPDate nCurVal = nCurVal/(1+iif(nCurVal<0,nFrate,nRrate))^nCurN if nCurVal < 0 nNegVal = nNegVal + nCurVal else nPosVal = nPosVal + nCurVal endif enddo if nNegVal = 0 .or. nPosVal = 0 wait " There must be at least one negative and one positive value! " return 0 endif nN = dMaxDate - dPDate nMirr = ((-nPosVal * (1+nRrate)^(nN-1))/nNegVal)^(1/(nN-1))-1 RETURN (1+nMirr)^365-1 *-- EoF: Xmirr() FUNCTION Xirr && {version 1.01} *------------------------------------------------------------------------------- *-- Programmer...: Ron Allen (CIS: 71201,2502) *-- Date.........: 01/25/1993 *-- Notes........: Used to calculate the Internal Rate of Return from *-- cashflows on random dates. Except for the need to *-- supply both the dates of transactions and the cashflows *-- in an 'nN' by 2 array, the other inputs are the same as *-- in Irr(). Dates may be in random order except for the *-- first date. The first date in the array establishes *-- the date to which present value applies. *-- Written for..: dBASEIV, version 1.5, tested on build xx71 *-- Rev. History.: 1.01 - 01/28/93 - to return 'effective' rate of interest *-- when compounded daily rather than the 'nominal' rate. *-- Also to count iterations without a sign change in PV. *-- Move division by nRatio outside inner loop. *-- Calls........: None *-- Called by....: Any *-- Usage........: Irr(<nN>, <cFlow>, <lSw>, <nGuess>) *-- Example......: Rate = Irr(5, "Cash", "Switch", .01) *-- Returns......: Effective Internal Rate of Return. *-- Parameters...: nN = number of cashflows in model *-- cFlow = name of the 'nN' by 2 array holding the *-- dates (col 1) and cashflows (col 2). Dates *-- may be entered in any order except for the *-- date, which is the date to which present *-- value applies. *-- lSw = name of a logical variable to be switched to *-- indicate valid IRR returned (.t.). *-- nGuess = optional guess for initializing search. *------------------------------------------------------------------------------- parameters nN, cFlow, lSw, nGuess private nI, nPosVal, nNegVal, nCurVal, nIRR, nNuDelta, nOlDelta, nBigchange private nSignChng, nRatio, dPDate, dMaxDate, nCurrPV, nSumDeriv private nSumPV, dCurDate, nIters, lSw1 store 0 to nI, nPosVal, nNegVal, nIters Store .t. to lSw declare nCashFlow[nN,2] store &cFlow[1,1] to dMaxDate, dPDate store .f. to lSw1 *-- Transfer cashflows to a private array and separate negatives from *-- positives. Find last date. do while nI < nN nI = nI+1 store &cFlow[nI,1] to nCashFlow[nI,1], dCurDate store &cFlow[nI,2] to nCashFlow[nI,2], nCurVal store max(dCurDate,dMaxDate) to dMaxDate if nCurVal < 0 nNegVal = nNegVal + nCurVal else nPosVal = nPosVal + nCurVal endif enddo if nNegVal = 0 .or. nPosVal = 0 wait "Must have at least one positive and one negative value" endif *-- Use initializing guess if provided, otherwise calculate from *-- weighted average returns. if pcount() = 4 nIRR = nGuess else nIRR = (((nPosVal+nNegVal-ncashflow[1,2])/-nCashFlow[1,2])-1)/; (dMaxDate-dPDate) endif *-- Housekeeping summary accumulators, etc., before entering loop store 1 to nNuDelta, nOlDelta store 0 to nSignChng, nBigChange *-- Loop until estimated rate indicated accuracy do while abs(nNuDelta) > .000001 store 0 to nI, nSumPV, nSumDeriv store 1 + nIrr to nRatio do while nI < nN nI = nI+1 *-- Calculate incremental PV and add to sum nCurrPV = nCashFlow[nI,2] / nRatio^(nCashFlow[nI,1] - dPDate) nSumPV = nSumPV + nCurrPV *-- Add incremental first derivative to derivative sum nSumDeriv = nSumDeriv - (nCashFlow[nI,1] - dPDate) * nCurrPV enddo *-- count iterations and test for sign change of future value if .not. lSw1 .and. nIters > 0 lSw1 = iif(sign(nOldPV) = sign(nSumPV),.f.,.t.) endif nIters = nIters + 1 nOldPV = nSumPV *-- Calculate indicated change in IRR nNuDelta = nRatio * nSumPV/nSumDeriv *-- Test for big changes in adjusted IRR, limit to 10 times *-- current guess for IRR and count big changes. if abs(nNuDelta/nIRR) > 10 nNuDelta = sign(nNuDelta) * 10 * nIRR nBigChange = nBigChange + 1 endif nIRR = nIRR - nNuDelta && Make adjustment to guess for IRR *-- Count reversals in adjustments to limit hunting nSignChng = nSignChng + iif(sign(nNuDelta) + sign(nOlDelta) = 0,1,0) nOlDelta = nNuDelta *-- Test for hunting, too many bigchanges or too large a solution *-- and set external switch if abnormal exit is used. if nSignChng + nBigChange > 10 .or. abs(nIRR) > 100 .or. ; (nIters > 9 .and. .not. lSw1) store .f. to lSw exit endif enddo RETURN (1+nIrr)^365 -1 *-- EoF: Xirr() FUNCTION FVirr && {version 1.01} *------------------------------------------------------------------------------- *-- Programmer...: Ron Allen (CIS: 71201,2502) *-- Date.........: 01/28/1993 *-- Notes........: Returns same roots as Irr(), but averages 20% faster. *-- Irr() searches for the roots of NPV (Net Present Value), *-- while FVirr() searches for the same roots of NFV (Net *-- Future Value), both with respect to the rate of return. *-- The user may wish to use this UDF in place of Irr() and *-- use Irr() as an alternate to help locate more multiple *-- solutions. The reason this UDF is 'usually' faster is due *-- to the fact that the NFV curve is 'usually' steeper as *-- it crosses the zero axis. *-- Written for..: dBASEIV, version 1.5, tested on build xx71 *-- Rev. History.: 1.01 01/28/93 - Modified Irr() to use Net Future Value *-- curve instead of Net Present Value curve. *-- Calls........: None *-- Called by....: Any *-- Usage........: Irr(<nN>, <cFlow>, <lSw>, <nGuess>) *-- Example......: Rate = Irr(6, "Cash", Switch, .01) *-- Returns......: Internal Rate of Return. *-- Parameters...: nN = number of cashflows in model *-- cFlow = name of the array holding the cashflows *-- lSw = name of a logical variable to be switched to *-- indicate valid IRR returned (.t.). *-- nGuess = optional guess for initialing search. *------------------------------------------------------------------------------- parameters nN, cFlow, lSw, nGuess private nI, nPosVal, nNegVal, nCurVal, nIRR, nNuDelta, nOlDelta, nBigchange private nSignChng, nDiscount, nRatio, nSumFV, nCurrFV, nSumDeriv, nOldFV private nIters, lSw1 store 0 to nI, nPosVal, nNegVal, nIters store .t. to lSw store .f. to lSw1 declare nCashFlow[nN] *-- Transfer cashflows to a private array and separate negatives from *-- positives do while nI < nN nI = nI+1 store &cFlow[nI] to nCashFlow[nI], nCurVal if nCurVal < 0 nNegVal = nNegVal + nCurVal else nPosVal = nPosVal + nCurVal endif enddo if nNegVal = 0 .or. nPosVal = 0 wait "Must have at least one positive and one negative value" endif *-- Use initializing guess if provided, otherwise calculate from *-- weighted average returns. if pcount() = 4 nIRR = nGuess else nIRR = ((-nPosVal/nNegVal)-1)/nN endif *-- Housekeeping summary accumulators, etc., before entering loop store 1 to nNuDelta, nOlDelta store 0 to nSignChng, nBigChange *-- Loop until estimated rate indicated accuracy do while abs(nNuDelta) > .000001 store 0 to nI, nSumFV, nSumDeriv *-- Set up cumulative denominator to calculate incremental NFV nRatio = 1 + nIRR nDiscount = nRatio^nN do while nI < nN nI = nI+1 nDiscount = nDiscount/nRatio *-- Calculate incremental FV and add to sum nCurrFV = nDiscount * nCashFlow[nI] nSumFV = nSumFV + nCurrFV *-- Add incremental first derivative to derivative sum nSumDeriv = nSumDeriv - nI * nCurrFV enddo *-- count iterations and test for sign change of future value if .not. lSw1 .and. nIters > 0 lSw1 = iif(sign(nOldFV) = sign(nSumFV),.f.,.t.) endif nIters = nIters + 1 nOldFV = nSumFV *-- Calculate indicated change in IRR nNuDelta = nRatio * nSumFV/nSumDeriv *-- Test for big changes in adjusted IRR, limit to 10 times *-- current guess for IRR and count big changes. if abs(nNuDelta/nIRR) > 10 nNuDelta = sign(nNuDelta) * 10 * nIRR nBigChange = nBigChange + 1 endif nIRR = nIRR - nNuDelta && Make adjustment to guess for IRR *-- Count reversals in adjustments to limit hunting nSignChng = nSignChng + iif(sign(nNuDelta) + sign(nOlDelta) = 0,1,0) nOlDelta = nNuDelta *-- Test for hunting, too many bigchanges or too large a solution *-- and set external switch if abnormal exit is used. if nSignChng + nBigChange > 10 .or. abs(nIRR) > 100 .or. ; (nIters > 9 .and. .not. lSw1) store .f. to lSw exit endif enddo RETURN nIRR *-- EoF: FVirr() FUNCTION FVxirr && {version 1.01} *------------------------------------------------------------------------------- *-- Programmer...: Ron Allen (CIS: 71201,2502) *-- Date.........: 01/28/1993 *-- Notes........: Same as Xirr() except that the Net Future Value (NFV) *-- function is used instead of the Net Present Value (NPV) *-- function. The roots are the same, but this function is *-- usually faster for the same reasons that FVirr() is *-- faster than Irr(). As in Xirr(), all dates except the *-- first date in the array may be in random order. The first *-- date in the nN by 2 array along with the maximum date *-- establishes the range of the investment analysis. *-- Written for..: dBASEIV, version 1.5, tested on build xx71 *-- Rev. History.: 1.01 - 01/28/93 - Modified Xirr() to find roots of the *-- Net Future Value curve. *-- Calls........: None *-- Called by....: Any *-- Usage........: Irr(<nN>, <cFlow>, <lSw>, <nGuess>) *-- Example......: Rate = Irr(5, "Cash", Switch, .01) *-- Returns......: Effective Internal Rate of Return. *-- Parameters...: nN = number of cashflows in model *-- cFlow = name of the 'nN' by 2 array holding the *-- dates (col 1) and cashflows (col 2). Dates *-- may be entered in any order except for the *-- date, which is the date to which present *-- value applies. *-- lSw = name of a logical variable to be switched to *-- indicate valid IRR returned (.t.). *-- nGuess = optional guess for initializing search. *------------------------------------------------------------------------------- parameters nN, cFlow, lSw, nGuess private nI, nPosVal, nNegVal, nCurVal, nIRR, nNuDelta, nOlDelta, nBigchange private nSignChng, nRatio, dPDate, dMaxDate, nCurrFV, nSumDeriv private nSumFV, dCurDate, lSw1, nIters store 0 to nI, nPosVal, nNegVal, nIters Store .t. to lSw declare nCashFlow[nN,2] store &cFlow[1,1] to dMaxDate, dPDate *-- Transfer cashflows to a private array and separate negatives from *-- positives. Find last date. do while nI < nN nI = nI+1 store &cFlow[nI,1] to nCashFlow[nI,1], dCurDate store &cFlow[nI,2] to nCashFlow[nI,2], nCurVal store max(dCurDate,dMaxDate) to dMaxDate if nCurVal < 0 nNegVal = nNegVal + nCurVal else nPosVal = nPosVal + nCurVal endif enddo if nNegVal = 0 .or. nPosVal = 0 wait "Must have at least one positive and one negative value" endif *-- Use initializing guess if provided, otherwise calculate from *-- weighted average returns. if pcount() = 4 nIRR = nGuess else nIRR = (((nPosVal+nNegVal-ncashflow[1,2])/-nCashFlow[1,2])-1)/; (dMaxDate-dPDate) endif *-- Housekeeping summary accumulators, etc., before entering loop store 1 to nNuDelta, nOlDelta store 0 to nSignChng, nBigChange store .f. to lSw1 *-- Loop until estimated rate indicated accuracy do while abs(nNuDelta) > .000001 store 0 to nI, nSumFV, nSumDeriv store 1 + nIrr to nRatio do while nI < nN nI = nI+1 *-- Calculate incremental FV and add to sum nCurrFV = nCashFlow[nI,2] * nRatio^(dMaxDate - nCashFlow[nI,1]) nSumFV = nSumFV + nCurrFV *-- Add incremental first derivative to derivative sum nSumDeriv = nSumDeriv + (dMaxDate - nCashFlow[nI,1]) * nCurrFV enddo *-- count iterations and test for sign change of future value if .not. lSw1 .and. nIters > 0 lSw1 = iif(sign(nOldFV) = sign(nSumFV),.f.,.t.) endif nIters = nIters + 1 nOldFV = nSumFV *-- Calculate indicated change in IRR nNuDelta = nRatio * nSumFV/nSumDeriv *-- Test for big changes in adjusted IRR, limit to 10 times *-- current guess for IRR and count big changes. if abs(nNuDelta/nIRR) > 10 nNuDelta = sign(nNuDelta) * 10 * nIRR nBigChange = nBigChange + 1 endif nIRR = nIRR - nNuDelta && Make adjustment to guess for IRR *-- Count reversals in adjustments to limit hunting nSignChng = nSignChng + iif(sign(nNuDelta) + sign(nOlDelta) = 0,1,0) nOlDelta = nNuDelta *-- Test for hunting, too many bigchanges or too large a solution *-- and set external switch if abnormal exit is used. if nSignChng + nBigChange > 10 .or. abs(nIRR) > 100 .or. ; (nIters > 9 .and. .not. lSw1) store .f. to lSw exit endif enddo RETURN (1+nIrr)^365 -1 *-- EoF: FVxirr() *------------------------------------------------------------------------------- *-- Note: The following functions are here as a courtesy, as they are used in at *-- least one of the functions above. *------------------------------------------------------------------------------- FUNCTION Zeroin *------------------------------------------------------------------------------- *-- Programmer..: Tony Lima (CIS: 72331,3724) and Jay Parsons (CIS: 70160,340) *-- Date........: 4/13/1992 *-- Notes.......: Finds a zero of a continuous function. *-- : In substance, what this function does is close in on a *-- : solution to a function that cannot otherwise be solved. *-- : Assuming Y = f(X), if Y1 and Y2, the values of the function *-- : for X1 and X2, have different signs, there must be at least *-- : one value of X between X1 and X2 for which Y = 0, if the *-- : function is continuous. This function closes in on such a *-- : value of X by a trial-and-error process. *-- : *-- : This function is very slow, so a maximum number of iterations *-- : is passed as a parameter. If the number of iterations is *-- : exceeded, the function will fail to find a root. If this *-- : occurs, pick different original "X" values, increase the *-- : number of iterations or increase the errors allowed. Once *-- : an approximate root is found, you can use values of X close *-- : on either side and reduce the error allowed to find an *-- : improved solution. Also, of course, the signs of Y must be *-- : different for the starting X values for the function to *-- : proceed at all. *-- : *-- : NOTE ESPECIALLY - There is NO guarantee that a root returned *-- : by this function is the only one, or the most meaningful. *-- : It depends on the function that this function calls, but if *-- : that function has several roots, any of them may be returned. *-- : This can easily happen with such called functions as net *-- : present value where the cash flows alternate from positive *-- : to negative and back, and in many other "real life" cases. *-- : See the discussion of @IRR in the documentation of a good *-- : spreadsheet program such as Quattro Pro for further *-- : information. *-- : *-- : The method used by this function is a "secant and bisect" *-- : search. The "secant" is the line connecting two X,Y *-- : points on a graph using standard Cartesian coordinates. *-- : Where the secant crosses the X axis is the best guess for *-- : the value of X that will have Y = 0, and will be correct *-- : if the function is linear between the two points. The *-- : basic strategy is to calculate Y at that value of X, then *-- : keep the new X and that one of the old X values that had *-- : a Y-value of opposite sign, and reiterate to close in. *-- : *-- : If the function is a simple curve with most of the change *-- : in Y close to one of the X-values, as often occurs if the *-- : initial values of X are poorly chosen, repeated secants *-- : will do little to find a Y-value close to zero and will *-- : reduce the difference in X-values only slightly. In this *-- : case the function shifts to choosing the new X halfway *-- : between the old ones, bisecting the difference and always *-- : reducing the bracket by half, for a while. *-- : *-- : While this function finds a "zero", it may be used to *-- : find an X corresponding to any other value of Y. Suppose *-- : the function of X is FUNCTION Blackbox( X ) and it is *-- : desired to find a value of X for which f(X) = 7. The trick *-- : is to interpose a function between Zeroin() and Blackbox() *-- : that will return a 0 to Zeroin() whenever Blackbox() returns *-- : 7. By calling that function, Zeroin() finds a value of *-- : X for which Blackbox( X ) = 7, as required: *-- : Result = Zeroin( "Temp", <other parameters omitted> ) *-- : *-- : FUNCTION Temp *-- : parameters nQ *-- : RETURN Blackbox( nQ ) - 7 *-- : *-- Written for.: dBASE IV Version 1.5 *-- Rev. History: Original function 1990. *-- : Modified to take optional parameters, 4/13/1992 *-- Calls : The function whose name is first parameter. *-- : NPV() Function in FINANCE.PRG *-- Called by...: Any *-- Usage.......: Zeroin( <cFunction>, <fX1>, <fX2>, <fAbserror>, ; *-- : <nMaxiter>, <n_Flag> ; *-- : [, xPass1 [, xPass2 [, xPass3 ] ] ] ) *-- Example.....: ? Zeroin( "Npv", 0, 200, .000001, 200, n_Flag, 11 ) *-- Returns : a float value representing a root, if n_Flag < 3. *-- Parameters..: cFunction, the name of the function to solve for a root. *-- fX1, one of the X-values between which the root is sought. *-- fX2, the second of these values. *-- Note: These MUST be chosen so the f( X ) values for the two *-- of them have opposite signs (they must bracket the result). *-- fAbserror, the absolute error allowed in the result. *-- nMaxiter, the maximum number of times to iterate. *-- n_Flag, an integer to signal success ( < 3 ) or failure. *-- xPass1 . . . 3, arguments to be passed through to cFunction. *-- The parameter "n_Flag" should be passed as a variable so it *-- may be accessed on return. The limit of 9 literal parameters *-- may require passing others as variables. The "xPass" *-- parameters are optional and the fact there are three of them *-- is arbitrary; they exist to hold whatever parameters may be *-- needed by the function cFunction being called aside from *-- the value of X for which it is being evaluated. Add more *-- and change the 3 "&cFunc." lines below if you need more. *-- Side effects: Uses and alters a global numeric variable, here called *-- "n_Flag", to report error conditions resulting in value *-- returned being meaningless. Possible n_Flag values are: *-- 1 success - root found within error allowed *-- 2 success - root was found exactly *-- 3 error - function value not converging *-- 4 error - original values do not bracket a root *-- 5 error - maximum iterations exceeded *------------------------------------------------------------------------------- parameters cFunc, fNearx, fFarx, fAbserr, nMaxiter, ; n_Flag, xPass1, xPass2, xPass3 private nSplits, fBracket, fFary, fNeary, nIters private fMaxabs, fOldx, fOldy, fDiffx, fAbsdiff, fSecant store 0 to nSplits, nIters fBracket = abs ( fNearx - fFarx ) fFary = &cFunc.( fFarx, xPass1, xPass2, xPass3 ) fNeary = &cFunc.( fNearx, xPass1, xPass2, xPass3 ) if sign( fNeary ) = sign( fFary ) n_Flag = 4 return float(0) endif fMaxabs = max( abs( fNeary ), abs( fFary ) ) n_Flag = 0 * Main iteration loop do while .t. if abs( fFary ) < abs( fNeary ) * Interchange fNearx and fFarx so that * fNearx is closer to a solution-- * abs( fNeary ) <= abs( fFary ) fOldx = fNearx fOldy = fNeary fNearx = fFarx fNeary = fFary fFarx = fOldx fFary = fOldy endif fDiffx = fFarx - fNearx fAbsdiff = abs( fDiffx ) * Test whether interval is too small to continue if fAbsdiff <= 2 * fAbserr if abs( fNeary ) > fMaxabs * Yes, but we are out of bounds n_Flag = 3 fNearx = float(0) else * Yes, and we have a solution! n_Flag = 1 endif exit endif * Save the last approximation to x and y fOldx = fNearx fOldy = fNeary * Check if reduction in the size of * bracketing interval is satisfactory. * If not, bisect until it is. nSplits = nSplits + 1 if nSplits >= 4 if 4 * fAbsdiff >= fBracket fNearx = fNearx + fDiffx / 2 else nSplits = 0 fBracket = fAbsdiff / 2 * Calculate secant fSecant = ( fNearx - fFarx ) * fNeary ; / ( fFary - fNeary ) * But not less than error allowed if abs( fSecant ) < fAbserr fNearx = fnearx + fAbserr * sign( fDiffx ) else fNearx = fNearx + fSecant endif endif endif * Evaluate the function at the new approximation fNeary = &cFunc.( fNearx, xPass1, xPass2, xPass3 ) * If it's exactly zero, we win! Run with it if fNeary = 0.00 n_Flag = 2 exit endif * Else adjust iteration count and quit if too * many iterations with no solution nIters = nIters + 1 if nIters > nMaxiter n_Flag = 5 fNearx = float( 0 ) exit endif * And finally keep as the new fFarx that one * of the previous approximations, fFarx and * fOldx, at which the function has a sign opposite * to that at the new approximation, fNearx. if sign( fNeary ) = sign( fFary ) fFarx = fOldx fFary = fOldy endif enddo RETURN fNearx *-- EoF: Zeroin() FUNCTION ArrayRows *------------------------------------------------------------------------------- *-- Programmer..: Jay Parsons (CIS: 70160,340) *-- Date........: 03/01/1992 *-- Notes.......: Number of Rows in an array *-- Written for.: dBASE IV, 1.1 *-- Rev. History: None *-- Calls.......: None *-- Called by...: Any *-- Usage.......: ArrayRows("<aArray>") *-- Example.....: n = ArrayRows("aTest") *-- Returns.....: numeric *-- Parameters..: aArray = Name of array *------------------------------------------------------------------------------- parameters aArray private nHi, nLo, nTrial, nDims nLo = 1 nHi = 1170 if type( "&aArray[ 1, 1 ]" ) = "U" nDims = 1 else nDims = 2 endif do while .T. nTrial = int( ( nHi + nLo ) / 2 ) if nHi < nLo exit endif if nDims = 1 .and. type( "&aArray[ nTrial ]" ) = "U" .or. ; nDims = 2 .and. type( "&aArray[ nTrial, 1 ]" ) = "U" nHi = nTrial - 1 else nLo = nTrial + 1 endif enddo RETURN nTrial *-- EoF: ArrayRows() *------------------------------------------------------------------------------- *-- EoP: FINANCE.PRG *-------------------------------------------------------------------------------